perm filename RESPC.F4[PAG,LCS]3 blob
sn#371516 filedate 1978-08-04 generic text, type T, neo UTF8
00100 SUBROUTINE RESPC
00200 COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00300 1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00400 1 RCLEF(0/7) /IVV/IV(1)
00500 COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00600 C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00700 COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00800 1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
00900 C INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01000 DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01100 1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01200 INTEGER DUMMY
01300 COMMON /PX/PN(1) /Q/Q(1)
01400 1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01500 1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
01600 DATA FIB/.8/ ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01700 1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/
01800 C RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
01900 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
02000 1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
02100 1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02200 1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02300 1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02400 1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02500 C RQ(2) IS R4, RQ(3) IS R5 ETC.
02600 CC DATA JXYZ/1/
02700
02800 IF(NMPG.NE.'PAGEA')GO TO 2000
02900 CC NPZ='PAGEZ'
03000 CC NPZF='PAGFZ'
03100 CC NPZG='PAGGZ'
03200 C SHOULD HANDLE UP TO 104 INPUT FILES. ADD HERE AND LATER FOR MORE RANGE.
03300 RNEXT=0
03400 2000 SPCNT=1.0
03500 CC DO 2001 K=1,JXYZ
03600 CC2001 RN(K)=0
03700 C MUST ZERO NN AND MM ARRAYS, ETC.
03800 JX=0
03900 JCEN=0
04000 C FLAG FOR CENTERED RESTS.
04100 XT=0
04200 PX=0
04300 CALL SHFT1(KQ)
04400 KK=L
04500 CC TYPE 3001,L
04600 C DELETES EXTRA BAR LINES, ETC.
04700 IF(IPG)CALL RESTS
04800 C??? IF(N)RETURN
04900 C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
05000 C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
05100 CALL SHIFT
05200 C L=NUMBER OF ITEMS FOR RHY RECONS.
05300 JJ2=L+2
05400 C FOR WDCNT IN .PAG FILE
05500 N=0
05600 S=-100
05700 R=0
05800 KCLEF=0
05900 NOGRCE=-1
06000 C GRACE NOTE FLAG
06100 TTT=0
06200 C FOR IRREG. NUMS. OF STAVES.
06300
06400 CC DO 61 K=1,L
06500 CC R=CODEN(KPN,K,Q,J)
06600 CC IF(R.GT.2)GO TO 61
06700 C NOW FOUND FIRST ITEM TO LEFT (NOTE OR REST, THAT IS.)
06800 CC IF(K.EQ.1)GO TO 161
06900 C JUMP OUT IF NOTHING BEFORE NOTE OR REST
07000 CC A=Q(J+3)+.5
07100 C GET POSITION OF NOTE OR REST
07200 CC DO 261 M=1,K-1
07300 CC R=CODEN(KPN,M,Q,J)
07400 CC IF(R.LT.9)GO TO 261
07500 CC IF(R.LT.17)Q(J+3)=A
07600 CC261 CONTINUE
07700 C MOVE ITEM TO RIGHT, .5 PAST NOTE OR REST
07800 CC GO TO 161
07900 CC61 CONTINUE
08000
08100 161 DO 601 K=1,L
08200 R=CODEN(KPN,K,Q,J)
08300 RZ=Q(J)
08400 CX J=KPN(K)
08500 CC N=N+1
08600 CC NN(N)=0
08700 CC MM(N)=J+3
08800 CALL MMNN(3)
08900 CX R=Q(J+1)
09000 IF(R.GT.2)GO TO 1801
09100 IF(Q(J+2).GT.TTT)TTT=Q(J+2)
09200 C FINDS HIGHEST STAFF NUM. NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
09300 IF(R.NE.1)GO TO 2801
09400 IF(RZ.LT.7)GO TO 601
09500 IF(Q(J+9).GT..05)GO TO 702
09600 IF(Q(J+9).EQ.0)GO TO 601
09700 CC IF(Q(J+8).EQ.1000)GO TO 601
09800 C SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
09900 NOGRCE=0
10000 GO TO 601
10100 CCC2801 IF(R.NE.2)GO TO 1801
10200 2801 IF(RZ.NE.7)GO TO 3801
10300 C DELETE ALL UP TO LABEL 1801 LATER. NEW CENTERED REST FEATURE. 5/29/78
10400 NN(N)=R
10500 GO TO 688
10600 3801 IF(RZ.LT.5)GO TO 601
10700 IF(IPG)GO TO 1801
10800 IF(RZ.LT.6)GO TO 1801
10900 RS=Q(J+3)
11000 C GET POS. OF CENTERED WHOLE REST
11100 TT=0
11200 B=Q(J+2)
11300 C GET THE STAFF NUM.
11400 DO 602 M=1,L
11500 T=CODEN(KPN,M,Q,JJ)
11600 A=Q(JJ+3)
11700 C GET POS. OF ITEM
11800 IF(A.GT.RS)GO TO 602
11900 C JUMP IF ITEM IS TO RIGHT OF REST
12000 IF(T.NE.4)GO TO 602
12100 C IS THE ITEM A BAR LINE
12200 IF(A.GT.TT)TT=A
12300 C FINDS BAR LINE CLOSEST TO LEFT OF REST
12400 602 CONTINUE
12500 C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
12600 T=20000
12700 A=20000
12800 C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
12900 DO 613 M=1,L
13000 IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
13100 IF(Q(JJ).LT.7)GO TO 609
13200 C SKIP IF RHYTH NOT IN P9
13300 IF(Q(JJ+9).LT..05)GO TO 613
13400 C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
13500 609 B=Q(JJ+3)
13600 C POS. OF ITEM
13700 X=B-TT
13800 IF(X)GO TO 613
13900 C JUMP IF ITEM IS TOO FAR TO LEFT
14000 IF(X.GT.A)GO TO 613
14100 A=X
14200 T=B
14300 C T = POS OF NOTE OR REST NEAREST BAR, ETC.
14400 613 CONTINUE
14500 IF(T.NE.20000)GO TO 612
14600 C JUMP IF NOTE OR REST FOUND
14700 JCEN=-1
14800 GO TO 1801
14900 612 Q(J+3)=T
15000 C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
15100 C MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
15200 C THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
15300 1801 IF(R.LT.4)GO TO 702
15400 IF(R.EQ.17)GO TO 1702
15500 IF(R.EQ.18)GO TO 1702
15550 IF(R.EQ.10)GO TO 702
15575 C FOUND A NUMBER. USE THIS IN RESTP
15600 IF(R.LE.7)GO TO 30
15700 IF(R.NE.44)GO TO 601
15800 IF(RZ.EQ.2)GO TO 601
15900 C RZ=2= BAR LINE ON UPPER STAFF
16000 IF(Q(J+6).EQ.0)GO TO 601
16100 IF(Q(J+5).EQ.0)GO TO 601
16200 C GETS LEFT END OF LINES, CRESC., DASHES.
16300 GO TO 604
16400 30 IF(R.NE.7)GO TO 605
16500 IF(RZ.LT.5)GO TO 604
16600 C JUMP FOR STANDARD TRILL
16700 RS=Q(J+7)
16800 IF(RS.EQ.1)GO TO 604
16900 IF(ABS(RS).GE.3)GO TO 604
17000 C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
17100 GO TO 601
17200 605 IF(R.NE.4)GO TO 604
17300 IF(RZ.LE.3)GO TO 702
17400 C JUMP IF IT IS A BAR LINE
17500 CC IF(RZ.LT.4)GO TO 601
17600 IF(Q(J+6).NE.0)GO TO 604
17700 C GO GET OTHER POS OF LINE
17800 GO TO 601
17900 1702 IF(Q(J+4).NE.0)GO TO 601
18000 IF(Q(J+2).NE.0)GO TO 601
18100 C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
18200 702 NN(N)=R
18300 GO TO 601
18400 C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
18500 604 CALL MMNN(6)
18600 C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
18700 IF(R.NE.6)GO TO 601
18800 C NEXT FOR BEAMS
18900 IF(RZ.LT.8)GO TO 608
19000 IF(Q(J+10).EQ.0)GO TO 608
19100 IF(Q(J+8))GO TO 608
19200 C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
19300 IF(Q(J+7).GT.0)CALL MMNN(8)
19400 C NEXT SHIFTS P8 OF COMPOSITE BEAMS
19500 608 IF(RZ.LT.7)GO TO 601
19600 IF(Q(J+7))GO TO 688
19700 C P7 IS NEG FOR TREMOLO
19800 IF(Q(J+8).EQ.0)GO TO 601
19900 C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
20000 688 IF(Q(J+9).GT.0)CALL MMNN(9)
20100 C FOUND A POS. IN P9
20200 601 CONTINUE
20300 KPG=TTT+1
20400 C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
20500
20600 C NEXT SORTS THE POINTS
20700 6000 J=1
20800 610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
20900 CALL EXCHG(MM(J),NN(J))
21000 C ABOVE EXCHGS --(J) AND --(J+1)
21100 IF(J.EQ.1)GO TO 710
21200 J=J-1
21300 GO TO 610
21400 710 J=J+1
21500 IF(J.LT.N)GO TO 610
21600 C NOW ALL SORTED
21700 CALL FNDEND(R)
21800 CALL SHFTQ(R)
21900 C SHIFTS TO PROPER HORIZ. POS.
22000 IF(IPG)CALL RESTP
22100 C RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS.
22200 IF(N.LE.0)GO TO 122
22300 C N IS NEG IF ONLY RESTS ON THIS LINE. GO BACK.
22400
22500 DO 119 K=1,150
22600 119 HH(K)=0
22700 C HH ARRAY WILL HOLD FINAL COMPOSITE.
22800 G(1)=0
22900 E(1)=0
23000 F(1)=0
23100 RN(1500)=0
23200 RN(2500)=0
23300 ST=0
23400 C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
23500 C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
23600 KE=0
23700 J=1000
23800 933 JJ=1500
23900 JJJ=2000
24000 T=0
24100 M=0
24200 A=0
24300 B=0
24400
24500 DO 33 K=1,N
24600 IF(NORH(KK))GO TO 33
24700 CC KK=NN(K)
24800 CC IF(KK.EQ.0)GO TO 33
24900 CC IF(KK.EQ.4)GO TO 2133
25000 CC IF(KK.EQ.17)GO TO 2133
25100 C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
25200 CC IF(KK.EQ.18)GO TO 2133
25300 CC IF(KK.GT.2)GO TO 33
25400 2133 LL=MM(K)-3
25500 IF(KK.LE.2)GO TO 1133
25600 RH=.01
25700 C RHYTHMIC VALUE OF BARLINE, METER, KSIG
25800 CCC IF(KK.NE.4)RH=.6
25900 GO TO 3133
26000 1133 IF(Q(LL+2).NE.ST)GO TO 33
26100 C JUMP IF NOT ON RIGHT STAFF
26200 RA=9
26300 IF(KK.EQ.2)RA=7
26400 IF(Q(LL).LT.RA-2)GO TO 33
26500 C JUMP IF WDCNT IS TOO SHORT
26600 IF(KK.EQ.1)GO TO 433
26700 IF(Q(LL).LT.6)GO TO 433
26800 C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
26900 RZ=Q(LL+8)
27000 C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
27100 IF(RZ.LE.0)GO TO 433
27200 Q(LL+7)=3
27300 C 3 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST
27400 IF(RZ.LT.8)GO TO 433
27500 Q(LL+5)=-3
27600 C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
27700 RZ=IFIX(RZ/2.0)+1.0
27800 IF(RZ.GT.6)RZ=6
27900 C LIMIT OF 8 ON RHYTH VAL.
28000 Q(LL+7)=RZ
28100 433 RH=Q(LL+IFIX(RA))
28200 IF(RH.EQ.0)GO TO 33
28300 3133 RZ=Q(LL+3)
28400 IF(ZERO(RZ,A).EQ.0)GO TO 133
28500 C JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
28600 RRH=RH
28700 C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
28800 TT=T
28900 C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
29000 J=J+1
29100 C UPDATE COUNTER IN POSITION ARRAY
29200 T=T+RH
29300 C ADD TO TOTAL RHYTHM
29400 RN(J)=T
29500 A=Q(LL+3)
29600 C SAVE POS. OF THIS NOTE.
29700 GO TO 33
29800 133 IF(RH.EQ.RHH)GO TO 33
29900 C IGNORE 2ND RHYTH IF SAME AS FIRST
30000 IF(ZERO(RZ,B).EQ.0)GO TO 333
30100 C JUMP IF A THIRD DIFFERENT RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
30200 TTT=TT
30300 C SAVE TOTAL RHYTHM TO THIS POINT.
30400 TT=TT+RH
30500 JJ=JJ+1
30600 C UPDATE COUNTER FOR 2ND ARRAY
30700 RN(JJ)=TT
30800 RRRH=RH
30900 B=A
31000 GO TO 33
31100 333 IF(RH.EQ.RRRH)GO TO 33
31200 TTT=TTT+RH
31300 JJJ=JJJ+1
31400 RN(JJJ)=TTT
31500 33 CONTINUE
31600 C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
31700 IF(ST.NE.0)GO TO 733
31800 KE=J-999
31900 C TOTAL NUM OF RHYTHMS ON STAFF1.
32000 CC IF(JPG.EQ.0)GO TO 2233
32100 IF(KPG.LE.1)GO TO 2233
32200 C KPG=0=PARTS; =1=PAGE, 1 STAFF
32300 C JUMP IF ONLY ONE STAFF
32400 C****733 KF=J-2499
32500 C KF=NUM OF RHYTHMS ON NEXT STAFF. **** NEVER USED ****
32600 733 ST=ST+1
32700 IF(ST.GT.1)GO TO 833
32800 C JUMP IF ALL STAVES HAVE BEEN READ.
32900 1233 J=2500
33000 GO TO 933
33100 833 IF(J.NE.2500)GO TO 1533
33200 C JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
33300 C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
33400
33500 2233 CALL RLOOP(HH,E,KE)
33600 C FOR SINGLE STAFF OF RHYTHM
33700 KL=KE
33800 GO TO 1333
33900 1533 K=1
34000 L=1
34100 M=0
34200 19 KK=K
34300 LL=L
34400 1 SM=10000
34500 K=K+1
34600 IF(K.GT.KE)GO TO 10
34700 4 L=L+1
34800 Y=F(L)
34900 B=Y-F(L-1)
35000 IF(B.LT.SM)SM=B
35100 2 X=E(K)
35200 A=X-E(K-1)
35300 C A AND B HAVE TRUE DURATIONS NOW
35400 IF(A.LT.SM)SM=A
35500 C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
35600 IF(ZERO(X,Y).EQ.0)GO TO 3
35700 C JUMP IF EQUAL RHYTHS
35800 IF(X.GT.Y)GO TO 4
35900 K=K+1
36000 C STEP FORWARD UNTIL X IS .GT. Y
36100 GO TO 2
36200 3 IF(K.NE.KK+1)GO TO 13
36300 IF(L.NE.LL+1)GO TO 14
36400 M=M+1
36500 G(M)=E(KK)
36600 GO TO 19
36700 13 IF(L.NE.LL+1)GO TO 15
36800 DO 16 J=KK,K-1
36900 M=M+1
37000 16 G(M)=E(J)
37100 GO TO 19
37200 14 DO 17 J=LL,L-1
37300 M=M+1
37400 17 G(M)=F(J)
37500 GO TO 19
37600 15 XM=SM-.001
37700 M=M+1
37800 P=E(KK)
37900 G(M)=P
38000 7 KK=KK+1
38100 LL=LL+1
38200 YM=SM*1.5
38300 C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
38400 S=P
38500 T=P
38600 27 A=E(KK)
38700 B=F(LL)
38800 IF(ZERO(A,B).EQ.0)GO TO 19
38900 X=ZERO(A,P)
39000 Y=ZERO(B,P)
39100 C FUNCT. ZERO: ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
39200 S=E(KK-1)
39300 T=F(LL-1)
39400 9 IF(A-S.LT.X-.01)X=ZERO(A,S)
39500 IF(B-T.LT.Y-.01)Y=ZERO(B,T)
39600 IF(A.GT.B+.01)GO TO 8
39700 B=A
39800 KK=KK+1
39900 62 IF(X.GT.YM)GO TO 5
40000 IF(X.EQ.0)GO TO 27
40100 P=P+SM
40200 25 M=M+1
40300 G(M)=P
40400 GO TO 27
40500 5 P=P+SM
40600 IF(P)GO TO 203
40700 C IF(P)ERROR
40800 IF(P.LT.B-.01)GO TO 5
40900 GO TO 25
41000 8 X=Y
41100 LL=LL+1
41200 GO TO 62
41300 10 M=M+1
41400 G(M)=E(KE)
41500 CC TYPE 410,(E(K),K=1,KE)
41600 CC TYPE 410,(F(K),K=1,KF)
41700 CC TYPE 410,(G(K),K=1,M)
41800 CBCB WRITE(21,410)(E(K),K=1,KE)
41900 CB WRITE(21,410)(F(K),K=1,KF)
42000 CB WRITE(21,410)(G(K),K=1,M)
42100 410 FORMAT(10F7.2)
42200 C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
42300 1033 JJ=1
42400 H(1)=0
42500 J=1
42600 K=2
42700 L=2
42800 511 IF(J.EQ.M)GO TO 911
42900 J=J+1
43000 X=G(J)
43100 1211 A=E(K)
43200 B=F(L)
43300 Y=ZERO(X,A)
43400 Z=ZERO(X,B)
43500 IF(A-B.GT..01)GO TO 1111
43600 IF(Y.EQ.0)GO TO 1311
43700 IF(X.LT.A-.01)GO TO 1111
43800 K=K+1
43900 1411 JJ=JJ+1
44000 H(JJ)=-A
44100 GO TO 1211
44200 1111 IF(Z.EQ.0)GO TO 1311
44300 IF(X.LT.B-.01)GO TO 1311
44400 L=L+1
44500 A=B
44600 GO TO 1411
44700
44800 1311 JJ=JJ+1
44900 H(JJ)=X
45000 IF(Y.EQ.0)GO TO 611
45100 IF(Z.EQ.0)GO TO 711
45200 IF(ZERO(A,B).EQ.0)GO TO 511
45300 P=A
45400 IF(P.GT.B+.01)GO TO 811
45500 IF(P.GT.X+.01)GO TO 511
45600 K=K+1
45700 GO TO 1011
45800 811 P=B
45900 IF(P.GT.X+.01)GO TO 511
46000 L=L+1
46100 1011 JJ=JJ+1
46200 H(JJ)=-P
46300 C NON-SPACED RHYTHS ARE NEG.
46400 GO TO 511
46500 611 K=K+1
46600 IF(Z.GT.0)GO TO 511
46700 711 L=L+1
46800 GO TO 511
46900 911 IF(HH(2).EQ.0)GO TO 2011
47000 K=2
47100 J=2
47200 L=1
47300 HHH(1)=0
47400 1511 IF(J.GT.JJ)GO TO 1811
47500 P=H(J)
47600 A=ABS(P)
47700 B=ABS(HH(K))
47800 IF(ZERO(B,A).EQ.0)GO TO 1611
47900 IF(A.GT.B)GO TO 1711
48000 J=J+1
48100 GO TO 1911
48200 1711 P=HH(K)
48300 GO TO 2211
48400 1611 J=J+1
48500 2211 K=K+1
48600 1911 L=L+1
48700 HHH(L)=P
48800 GO TO 1511
48900 2011 CALL RLOOP(HH,H,JJ)
49000 KL=JJ
49100 GO TO 2111
49200 1811 CALL RLOOP(HH,HHH,L)
49300 KL=L
49400 2111 IF(ST.GE.KPG)GO TO 1333
49500 CALL RLOOP(E,G,M)
49600 KE=M
49700 C GO WAY BACK AND READ ANOTHER LINE.
49800 GO TO 1233
49900 1333 E(1)=0
50000 GO TO 2333
50100 TYPE 410,(HH(K),K=1,KL)
50200 WRITE(21,410)(HH(K),K=1,KL)
50300 2333 JD=1
50400 C JD IS COUNTER FOR DUMMY POSITIONS.
50500 DUMMY(1)=1
50600 ST=0
50700 183 B=0
50800 LL=2
50900
51000 DO 181 K=1,N
51100 IF(NORH(L))GO TO 181
51200 C LOOK FOR DUMMY RHYTHMS.
51300 IF(L.LE.2)GO TO 2184
51400 RZ=.01
51500 C RHYTHMIC VALUE OF BAR, METER, KSIG. CHANGED TO ABS. SIZE LATER.
51600 GO TO 1184
51700 2184 LF=MM(K)
51800 IF(Q(LF-1).NE.ST)GO TO 181
51900 C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
52000 J=6
52100 IF(L.EQ.2)J=4
52200 RZ=Q(LF+J)
52300 1184 B=B+RZ
52400 184 V=ABS(HH(LL))
52500 IF(ZERO(B,V).GT.0)GO TO 182
52600 C FOUND RHYTH MATCH
52700 JD=JD+1
52800 DUMMY(JD)=LL
52900 LL=LL+1
53000 GO TO 181
53100 182 IF(B.LT.V-.01)GO TO 181
53200 LL=LL+1
53300 GO TO 184
53400 181 CONTINUE
53500 ST=ST+1
53600 IF(ST.LT.KPG)GO TO 183
53700
53800 C NEXT SORT DUMMY ARRAY
53900 J=0
54000 185 DO 186 K=2,JD
54100 IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
54200 DO 188 LL=K,JD
54300 188 DUMMY(LL-1)=DUMMY(LL)
54400 JD=JD-1
54500 GO TO 185
54600 187 IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
54700 CALL EXCH(DUMMY(K),DUMMY(K-1))
54800 GO TO 185
54900 186 CONTINUE
55000 C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
55100 PX=0
55200 LF=0
55300 K=1
55400 V=0
55500
55600 81 K=K+1
55700 IF(K.GT.KL)GO TO 1433
55800 B=HH(K)
55900 A=B-V
56000 V=B
56100 IF(V)GO TO 82
56200 85 W=V
56300 IF(A.GT.0.01)GO TO 89
56400 C .GT. BECAUSE OF ROUND-OFF ERROR
56500 T=5
56600 IF(HH(K+1)-V.LE..01)T=2
56700 PX=PX+T
56800 C THIS FOR BARS, KSIG, METER
56900 GO TO 189
57000 89 PX=PX+14.0*EXP(ALOG(A)*0.5849624)
57100 C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5)) NOT FIBBONACI (1.618)
57200 CC89 PX=PX+PFIBX(A)
57300 189 E(K)=PX
57400 IF(LF.NE.0)GO TO 86
57500 GO TO 81
57600 82 LF=K
57700 83 K=K+1
57800 V=HH(K)
57900 IF(V)GO TO 83
58000 A=V-W
58100 GO TO 85
58200 86 LL=LF-1
58300 D=E(K)-E(LL)
58400 87 S=-HH(LF)-HH(LL)
58500 T=HH(K)-HH(LL)
58600 T=S/T
58700 C THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
58800 E(LF)=E(LL)+D*T
58900 LF=LF+1
59000 IF(LF.NE.K)GO TO 87
59100 LF=0
59200 GO TO 81
59300
59400 1433 GO TO 2433
59500 TYPE 410,(E(K),K=1,KL)
59600 WRITE(21,410)(E(K),K=1,KL)
59700 C 5 IS SPACE AFTER 1ST BARLINE
59800 2433 R8=RNEXT
59900 C POS OF 1ST BAR = END OF PREV. LINE
60000 IF(ENDLN.EQ.0)RNEXT=9
60100 C MAKES ROOM FOR 1ST CLEF.
60200 KL=KL-1
60300 J=0
60400 R5=0
60500 KK=1
60600 JD=1
60700 W=0
60800 LF=0
60900
61000 DO 80 K=1,N
61100 IF(NORH(L))GO TO 80
61200 A=Q(MM(K))
61300 IF(ZERO(A,W).EQ.0)GO TO 80
61400 C SKIP IF SAME POS OF NOTE OR REST.
61500 W=A
61600 R7=R8
61700 190 J=J+1
61800 IF(J.LE.KL)GO TO 290
61900 203 FORMAT(' FOUND CENTERED WHOLE REST!')
62000 LL=0
62100 IF(JCEN.GE.0)GO TO 120
62200 TYPE 203
62300 GO TO 121
62400 120 W=LL
62500 A=0
62600 DO 124 K=1,N
62700 LF=NN(K)
62800 IF(LF.GT.2)GO TO 124
62900 IF(LF.EQ.0)GO TO 124
63000 KE=MM(K)
63100 IF(Q(KE-1).NE.W)GO TO 124
63200 C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
63300 JD=6
63400 IF(LF.EQ.2)JD=4
63500 A=A+Q(KE+JD)
63600 124 CONTINUE
63700 TYPE 123,LL,A
63800 LL=LL+1
63900 IF(LL.LT.KPG)GO TO 120
64000 123 FORMAT(' STF',I2,' =',F9.5,' QTRS')
64100 121 PAUSE' *****RHYTHM MISMATCH OR MISALIGNED NOTES*****'
64200 GO TO 90
64300 290 IF(DUMMY(JD).NE.J)GO TO 190
64400 JD=JD+1
64500 90 R8=RNEXT+E(J)
64600 R4=R5
64700 R5=A
64800 X=(R8-R7)/(R5-R4)
64900 S=R7-R4*X
65000 DO 91 L=KK,K
65100 LL=MM(L)
65200 91 Q(LL)=S+X*Q(LL)
65300 KK=K+1
65400 80 CONTINUE
65500
65600 IF(KK.GT.K)GO TO 180
65700 C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
65800 R7=Q(LL)-R5
65900 C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
66000 DO 280 L=KK,K
66100 LL=MM(L)
66200 280 Q(LL)=R7+Q(LL)
66300 180 JJ=JJ2-2
66400 L=JJ2
66500 M=0
66600 C FLAG FOR REST AT START OF LINE
66700
66800 JJJ=-1
66900 C FLAG FOR 1ST BAR OF LINE 12/77
67000 V=0
67100 ACCI=0
67200 DO 12 J=1,JJ
67300 R=CODEN(KPN,J,Q,LA)
67400 CC IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
67500 IF(R.EQ.4)GO TO 680
67600 IF(M)GO TO 780
67700 IF(R.NE.2)GO TO 780
67800 IF(KBR.EQ.0)GO TO 12
67900 C LOOK FOR RESTS AT FRONT OF LINE.
68000 X=0
68100 CALL TURN(J,JJ,1,X)
68200 PGTRN(KBR)=PGTRN(KBR)+X
68300 M=-1
68400 780 IF(R.NE.1)GO TO 12
68500 IF(V.NE.Q(LA+3))GO TO 782
68600 IF(JACC)GO TO 781
68700 782 IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
68800 JACC=-1
68900 ACCI=ACCI+.5
69000 V=Q(LA+3)
69100 781 M=-1
69200 IF(NOGRCE)GO TO 12
69300 C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
69400 C FOUND A NOTE
69500 IF(Q(LA+9).GT.0.05)GO TO 12
69600 C JUMP IF NOT A GRACE NOTE
69700 R=Q(LA+2)
69800 C THE STAFF NUM.
69900 DO 580 LF=J+1,JJ
70000 IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
70100 IF(Q(JD+2).NE.R)GO TO 580
70200 IF(Q(JD).LT.7)GO TO 580
70300 IF(Q(JD+9).EQ.0)GO TO 580
70400 C CHORD NOTE
70500 R4=Q(LA+3)
70600 CC R4=Q(LA+3)-1
70700 R5=Q(JD+3)
70800 C THE STAFF # IS IN R2
70900 R8=RSTFAC(IFIX(R2+1))+.5
71000 IF(Q(JD+4).LT.80)R8=R8*2
71100 C INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
71200 R8=R5-R8
71300 CC R8=R5-R8-1
71400 CCC IF(R4.EQ.R5)GO TO 12
71500 IF(R4.NE.R5)GO TO 480
71600 C GRACE NOTE AT START OF LINE ***** FIX THIS????
71700 DO 880 KE=1,LF-1
71800 880 Q(KPN(KE)+3)=R8
71900 C MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
72000 GO TO 12
72100 480 R2=Q(LA+2)
72200 R9=R5
72300 CALL PTMOVE(Q,KPN)
72400 CC TYPE 9999,Q(J+3),Q(JD+3)
72500 CC9999 FORMAT(2F)
72600 GO TO 12
72700 580 CONTINUE
72800 GO TO 12
72900 C ABOVE FOR GRACE NOTE SPACING.
73000 680 KBR=KBR+1
73100 C BAR LINE COUNTER
73200 T=Q(LA+3)
73300 C TOTAL SPACE
73400 X=0
73500 CALL TURN(J-1,1,-1,X)
73600 CALL TURN(J+1,JJ,1,X)
73700 222 PGTRN(KBR)=X
73800 C FINDS PAGE-TURN POSSIBILITIES
73900 C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
74000 IF(JJJ)RNEXT=RNEXT-6
74100 C JJJ=-1 IF 1ST BAR OF LINE. 12/77
74200 JJJ=0
74300 BARS(KBR)=(T-RNEXT+ACCI)*BFAC
74400 C SIZE OF THIS MEASURE + .5*ACCIDENTALS
74500 ACCI=0
74600 K=J
74700 RNEXT=T
74800 12 CONTINUE
74900
75000 IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
75100 RNEXT=RNEXT+3
75200 JJ2=L
75300 C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
75400 CC???380 LCNT=0
75500 CC??? NDPY=0
75600 C JJ2 IS END OF PNTR DATA
75700 JPQ=KPN(JJ2-1)+1
75800 CALL PUTEXT(NMPG,'PAG')
75900 CALL EXTOUT(RSTFAC,128)
76000 CALL EXTOUT(PN,JJ2)
76100 CALL EXTOUT(Q,JPQ)
76200 CALL FINEXT
76300
76400 LASTNM=NMPG
76500 NMPG=NMPG+2
76600 IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
76700 C WILL GO FROM PAGEA TO PAGFZ, ETC. (104) ADD TO THIS IF NEEDED.
76800 IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
76900 IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
77000 122 ENDLN=RNEXT
77100 END